Info-Mac 4/Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso/Development/Source/DBL Pascal Library/Fast-BV/Fast-BV Test.p

Text File | 1992-01-28 | 4KB | 192 lines

program FastBVTest;

    uses
        FastBitVector;

    const
        BigSize = 10000;
        BigLimit = BigSize - 1;

    type
        BigRange = 0..BigLimit;

    var
        bv: BitVector;
        s: set of BigRange;
        i: Integer;
        err: OSErr;

{$PUSH}
{$R-}
{$D-}
{$V-}
    function Quick_MemberOfSet (theIDSetPtr: PTR; theMember: INTEGER): BOOLEAN;
        const
            idSize = (8 * SIZEOF(s)) - 1;    {Bit size, 0-based}
    begin
        Quick_MemberOfSet := BitTst(theIDSetPtr, idSize - theMember);
    end;
{$POP}

    procedure BasicDemo;

        procedure DisplayBV (theBV: BitVector);
            var
                i: Integer;
        begin
            writeln('---');
            for i := 0 to BVLength(bv) - 1 do
                writeln(i : 2, ' ', BVTestBit(bv, i));
            writeln('---');
        end;

        var
            i: Integer;
    begin
        bv := NewBV(10);
        BVClearAllBits(bv);
        BVSetBit(bv, 0);
        BVSetBit(bv, 3);
        BVSetBit(bv, 5);
        BVSetBit(bv, 9);
        DisplayBV(bv);
        i := -1;
        repeat
            BVFindNextSetBit(bv, i);
            writeln(i : 2)
        until i = -1;
        BVSetAllBits(bv);
        BVClearBit(bv, 2);
        BVClearBit(bv, 7);
        BVClearBit(bv, 8);
        DisplayBV(bv);
        err := BVExtend0(bv, 15);
        DisplayBV(bv);
        err := BVExtend1(bv, 18);
        DisplayBV(bv);
        BVTruncate(bv, 3);
        DisplayBV(bv);
        DisposeBV(bv);
    end;

    procedure RunTimeTrial (n: Integer);
        var
            expectedCount, count: Integer;

        procedure InitTestVector;
            var
                i: Integer;
        begin
            bv := NewBV(BigSize);
            if bv = nil then
                begin
                    writeln('NewBV failed');
                    Halt;
                end;
            BVClearAllBits(bv);
            expectedCount := BigLimit div n + 1;
            count := 0;
            for i := 0 to BigLimit div n do
                BVSetBit(bv, i);
        end;

        procedure InitTestSet;
            var
                i: Integer;
        begin
            s := [];
            expectedCount := BigLimit div n + 1;
            count := 0;
            for i := 0 to BigLimit div n do
                s := s + [i];
        end;

        procedure CheckCount;
        begin
            if count <> expectedCount then
                writeln('Count is wrong: ', count : 1, ' vs ', expectedCount : 1);
        end;

        const
            Passes = 5;
        var
            i, pass: Integer;
            t: Longint;
    begin
        writeln('Time trial, density = 1/', n : 1);

{Find all set bits using BVFindNextSetBit}
        t := TickCount;
        for pass := 1 to Passes do
            begin
                InitTestVector;
                i := -1;
                repeat
                    BVFindNextSetBit(bv, i);
                    if i >= 0 then
                        count := count + 1;
                until i = -1;
                CheckCount;
                DisposeBV(bv);
            end;
        writeln((TickCount - t) / Passes : 6 : 1, ' BVFindNextSetBit');

{Find all set bits using BVTestBit}
        t := TickCount;
        for pass := 1 to Passes do
            begin
                InitTestVector;
                for i := 0 to BigLimit do
                    if BVTestBit(bv, i) then
                        count := count + 1;
                CheckCount;
                DisposeBV(bv);
            end;
        writeln((TickCount - t) / Passes : 6 : 1, ' BVTestBit');

{Find all set bits using Quick_MemberOfSet}
        t := TickCount;
        for pass := 1 to Passes do
            begin
                InitTestSet;
                for i := 0 to BigLimit do
                    if Quick_MemberOfSet(@s, i) then
                        count := count + 1;
                CheckCount;
                s := [];
            end;
        writeln((TickCount - t) / Passes : 6 : 1, ' Quick_MemberOfSet');

{Find all set bits using intrinsic 'IN' function}
        t := TickCount;
        for pass := 1 to Passes do
            begin
                InitTestSet;
                for i := 0 to BigLimit do
                    if i in s then
                        count := count + 1;
                CheckCount;
                s := [];
            end;
        writeln((TickCount - t) / Passes : 6 : 1, ' IN');
    end;

begin
{Do the customary and mandatory initializations, respectively}
    ShowText;
    InitFastBitVector;

{Demonstrate the most basic functions}
    BasicDemo;

{Demonstrate time performance relative to other approaches}
    RunTimeTrial(1000);
    RunTimeTrial(100);
    RunTimeTrial(20);
    RunTimeTrial(10);
    RunTimeTrial(5);
    RunTimeTrial(4);
    RunTimeTrial(3);
    RunTimeTrial(2);
    RunTimeTrial(1);
end.